Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue32/survive/demo1.pas

Pascal/Delphi Source File | 1998-02-23 | 6.5 KB | 252 lines

unit demo1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  SQLOLE_TLB, StdCtrls, ActiveX;

type
  TForm1 = class(TForm)
    edtServerName: TEdit;
    Label1: TLabel;
    edtUsername: TEdit;
    edtPassword: TEdit;
    Label2: TLabel;
    Label3: TLabel;
    btnConnect: TButton;
    memResults: TMemo;
    lstDatabaseNames: TListBox;
    Label4: TLabel;
    lstTableNames: TListBox;
    Label5: TLabel;
    lstColumnNames: TListBox;
    Label6: TLabel;
    memQuery: TMemo;
    Label7: TLabel;
    Label8: TLabel;
    btnExecSQL: TButton;
    btnOpenSQL: TButton;
    Button3: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnConnectClick(Sender: TObject);
    procedure lstDatabaseNamesClick(Sender: TObject);
    procedure lstTableNamesClick(Sender: TObject);
    procedure btnExecSQLClick(Sender: TObject);
    procedure btnOpenSQLClick(Sender: TObject);
  private
  protected
    function GetCurrentDatabase: Database;
    function GetCurrentDatabaseIndex: Integer;
    function GetCurrentTable: Table;
    function GetCurrentTableIndex: Integer;
  public
    Server: SQLServer;
    property CurrentDatabase: Database read GetCurrentDatabase;
    property CurrentDatabaseIndex: Integer read GetCurrentDatabaseIndex;
    property CurrentTable: Table read GetCurrentTable;
    property CurrentTableIndex: Integer read GetCurrentTableIndex;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

function PadStr(aStr: string; aWidth: Integer): string;
var
  L: Integer;
begin
  L := Length(aStr);
  if L >= aWidth then
    Result := Copy(aStr, 1, aWidth)
  else
    Result := aStr + StringOfChar(' ', aWidth - L);
end;

function TForm1.GetCurrentDatabase: Database;
begin
  Result := Server.Databases.Item(CurrentDatabaseIndex);
end;

function TForm1.GetCurrentDatabaseIndex: Integer;
begin
  Result := lstDatabaseNames.ItemIndex + 1;
end;

function TForm1.GetCurrentTable: Table;
begin
  Result := CurrentDatabase.Tables.Item(CurrentTableIndex);
end;

function TForm1.GetCurrentTableIndex: Integer;
begin
  Result := lstTableNames.ItemIndex + 1;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  I: Integer;
begin
  Server := CoSQLServer.Create;
  with Server.Application.Properties do
    For I := 1 to Count do
      With Item(I) do
        memResults.Lines.Add (Format ('%s=%s', [Name, Value]));
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Server := nil;
end;

procedure TForm1.btnConnectClick(Sender: TObject);
var
  I: Integer;
begin
  if btnConnect.Caption = 'Disconnect' then
  begin
    Server.Disconnect;
    lstDatabaseNames.Items.Clear;
    lstTableNames.Clear;
    lstColumnNames.Clear;
    btnConnect.Caption := 'Connect';
  end
  else
  begin
    Server.Connect(edtServerName.Text, edtUserName.Text, edtPassword.Text);
    for I := 1 to Server.Databases.Count do
      lstDatabaseNames.Items.Add(Server.Databases.Item(I).Name);
    btnConnect.Caption := 'Disconnect';
  end;
end;

procedure TForm1.lstDatabaseNamesClick(Sender: TObject);
var
  I: Integer;
begin
  with lstTableNames.Items do
  begin
    Clear;
    lstColumnNames.Clear;
    BeginUpdate;
    Screen.Cursor := crHourglass;
    try
      with CurrentDatabase.Tables do
        for I := 1 to Count do
          lstTableNames.Items.Add(Item(I).Name);
    finally
      EndUpdate;
      Screen.Cursor := crDefault;
    end;
  end;
end;

procedure TForm1.lstTableNamesClick(Sender: TObject);
var
  I: Integer;
begin
  with lstColumnNames.Items do
  begin
    Clear;
    BeginUpdate;
    Screen.Cursor := crHourglass;
    try
      with CurrentTable.Columns do
        for I := 1 to Count do
          lstColumnNames.Items.Add(Item(I).Name);
    finally
      EndUpdate;
      Screen.Cursor := crDefault;
    end;
  end;
end;

procedure TForm1.btnExecSQLClick(Sender: TObject);
begin
  CurrentDatabase.ExecuteImmediate(memQuery.Text, SQLOLEExec_Default);
end;

procedure TForm1.btnOpenSQLClick(Sender: TObject);
var
  I: Integer;
  Row, Col, SetNum : Integer;
  S: string;
  ColWidth: Integer;
begin
  Screen.Cursor := crHourglass;
  try
    ColWidth := 20;
    with CurrentDatabase.ExecuteWithResults(memQuery.Text) do
    begin
      memResults.Lines.Add('');
      memResults.Lines.Add('Query Result Set Properties:');
      if (ResultSets = 0) then
        Exit;

      with Properties do
        for I := 1 to Count do
          with Item(I) do
            memResults.Lines.Add (Format ('***%s=%s', [Name, Value]));

      for SetNum := 1 to ResultSets do
      begin
        CurrentResultSet := SetNum;

        with Properties do
          for I := 1 to Count do
            with Item(I) do
              memResults.Lines.Add (Format ('***%s=%s', [Name, Value]));


        { echo the column names }
        S := '';
        for Col := 1 to Columns do
          S := S + PadStr(ColumnName[Col], ColWidth);
        memResults.Lines.Add(S);

        for Row := 1 to Rows do
        begin
          S := '';
          for Col := 1 to Columns do
            case ColumnType[Col] of
              SQLOLE_DTypeChar,
              SQLOLE_DTypeVarchar,
              SQLOLE_DTypeText,
              SQLOLE_DTypeDateTime,
              SQLOLE_DTypeDateTime4:
                S := S + PadStr(GetColumnString(Row, Col), ColWidth);
              SQLOLE_DTypeInt1,
              SQLOLE_DTypeInt2,
              SQLOLE_DTypeInt4:
                S := S + PadStr(IntToStr(GetColumnLong(Row, Col)), ColWidth);
              SQLOLE_DTypeFloat4,
              SQLOLE_DTypeMoney4:
                S := S + PadStr(FloatToStr(GetColumnFloat(Row, Col)), ColWidth);
              SQLOLE_DTypeFloat8,
              SQLOLE_DTypeMoney:
                S := S + PadStr(FloatToStr(GetColumnDouble(Row, Col)), ColWidth);
              SQLOLE_DTypeImage:
                S := S + PadStr('(image)', ColWidth);
              SQLOLE_DTypeVarBinary,
              SQLOLE_DTypeBinary:
                S := S + PadStr('(binary)', ColWidth);
              SQLOLE_DTypeBit:
                S := S + PadStr(IntToStr(Ord(GetColumnBool(Row, Col))), ColWidth);
              else
                S := S + PadStr('(xxxxx)', ColWidth);
            end;
          memResults.Lines.Add(S);
        end;
      end;
    end;
  finally
    Screen.Cursor := crDefault;
  end;
end;

end.